home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1985-06-04 | 3.1 KB | 131 lines |
- 10 REM **** CPAHOLY ****
- 12 DEFINT A-Z:DEFSNG H
- 15 DIM H(1000),D$(12)
- 18 CLOSE
- 20 PRINT "**** THIS MODULE CREATES AND MANAGES HOLIDAY [.HOL] FILES ****"
- 21 D$(2)="February"
- 22 D$(3)="March"
- 23 D$(4)="April"
- 24 D$(5)="May"
- 25 D$(6)="June"
- 26 D$(7)="July"
- 27 D$(8)="August"
- 28 D$(9)="September"
- 29 D$(10)="October"
- 30 PRINT
- 31 D$(1)="January"
- 32 D$(11)="November"
- 33 D$(12)="December"
- 40 RSVRD$=".BAS":EXTN$=".HOL"
- 50 INPUT "Enter the name of the base data file ";F9$
- 55 GOSUB 12000
- 60 F$=F9$:GOSUB 10250:IF F9=1 THEN 50
- 140 GOSUB 8000 'READ HOLIDAY FILE
- 150 IF N=0 THEN 500
- 310 PRINT "**** LIST OF HOLIDAYS FOR THE BASE DATA FILE ";G$;"****":PRINT
- 311 FOR I=1 TO N
- 312 D8=H(I)
- 314 GOSUB 4500
- 315 PRINT I;D$(M5);D5;"19";RIGHT$(STR$(Y5),2)
- 316 IF I MOD 20=0 THEN INPUT "Press ENTER to Continue ",Q$
- 317 NEXT I
- 318 PRINT
- 320 INPUT "Do you want to change, add, delete or quit (C/A/D/Q) ";Q$
- 330 IF Q$="Q" THEN 440
- 335 IF Q$="D" THEN 2000
- 340 IF Q$="A" THEN 500
- 345 IF Q$<>"C" THEN BEEP:GOTO 320
- 350 INPUT "Enter number of holiday to change ";K
- 360 IF K>N THEN 350
- 400 INPUT "Enter new date in MM,DD,YY format ";M6,D6,Y6
- 410 GOSUB 5000
- 420 H(K)=D8
- 430 GOTO 310
- 440 GOSUB 3000
- 450 CHAIN "CPAMENU"
- 500 INPUT "Enter holiday in MM,DD,YY format (0,0,0 if end) ";M6,D6,Y6
- 505 IF M6=0 THEN 310
- 510 GOSUB 5000
- 512 N=N+1
- 514 H(N)=D8
- 516 GOTO 500
- 1000 I=0
- 1010 PRINT "**** ENTER HOLIDAYS IN MM,DD,YY FORMAT - ENTER 0,0,0 IF AT END ****"
- 1020 I=I+1
- 1030 PRINT "Enter holiday";I;
- 1040 INPUT M6,D6,Y6
- 1050 IF M6=0 THEN 1090
- 1060 GOSUB 5000
- 1070 H(I)=D8
- 1080 GOTO 1020
- 1090 N=I-1
- 1100 GOTO 310
- 2000 'DELETE
- 2010 INPUT "Enter number of holiday to delete ";K
- 2020 IF K=0 THEN 310
- 2030 IF K>N THEN BEEP:PRINT "**** INVALID RESPONSE - MAXIMUM IS";N;"****":GOTO 2010
- 2040 FOR J=K TO N-1
- 2050 H(J)=H(J+1)
- 2060 NEXT
- 2070 N=N-1:GOTO 310
- 3000 REM WRITE ARRAY TO FILE
- 3002 INPUT "File changes or Quit (F/Q) ";Q$
- 3003 IF LEFT$(Q$,1)="Q" THEN RETURN
- 3004 PRINT "**** FILENAME IS ";F9$;" ****"
- 3009 OPEN F9$ FOR OUTPUT AS #1
- 3020 FOR I=1 TO N
- 3030 WRITE #1,H(I)
- 3040 NEXT I
- 3045 CLOSE #1
- 3050 RETURN
- 4490 REM ** CONVERT CENTURY DAY TO MM, DD, YY **************************
- 4500 T9=INT(D8/1461)
- 4510 Y5=INT((D8-T9+364)/365)
- 4520 Y4=D8-INT((Y5-1)*1461/4)
- 4530 L8=2
- 4540 IF Y5/4=INT(Y5/4) THEN L8=1
- 4550 T9=Y4
- 4560 IF T9>61-L8 THEN T9=T9+L8
- 4570 M5=INT((T9*9+269)/275)
- 4580 D5=T9-INT(M5*275/9)+30
- 4590 D4=D8-INT(D8/7)*7+1
- 4600 RETURN
- 4999 REM ** GET DAY OF CENTURY OF STARTING DATE **
- 5000 L8=2
- 5010 IF INT(Y6/4)=Y6/4 THEN L8=1
- 5020 D7=INT(M6*275/9)+D6-30
- 5030 IF M6>2 THEN D7=D7-L8
- 5040 D8=INT((Y6-1)*1461/4)+D7
- 5050 RETURN
- 8000 ON ERROR GOTO 8200
- 8010 OPEN F9$ FOR INPUT AS #1
- 8020 J=0
- 8030 J=J+1
- 8040 IF EOF(1) THEN 8100
- 8050 INPUT #1,H(J)
- 8060 GOTO 8030
- 8100 N=J-1 'NUMBER OF HOLIDAYS
- 8110 CLOSE #1:RETURN
- 8200 IF ERR=53 THEN PRINT "**** NEW FILE ****":RESUME 8110
- 8210 GOTO 11000
- 10000 PRINT "**** NEW FILE ****":CLOSE #1:GOTO 1000
- 10250 REM SUBROUTINE TO CHECK FILENAMES - PASS IN F9$
- 10254 F9=0
- 10256 L9=LEN(F9$):IF L9>12 OR L9<1 THEN BEEP:GOTO 10274
- 10258 I9=INSTR(F9$,".")
- 10260 IF I9<>0 THEN 10266
- 10262 IF L9<9 THEN F9$=F9$+EXTN$ ELSE F9$=LEFT$(F9$,8)+EXTN$
- 10264 GOTO 10280
- 10266 IF RIGHT$(F9$,4)=EXTN$ THEN 10280
- 10268 PRINT "**** WRONG EXTENSION - PLEASE DIAL AGAIN ****":BEEP:GOTO 10278
- 10270 IF RIGHT$(F9$,4)=RSRVD$ THEN 10272 ELSE 10280
- 10272 PRINT "**** RESERVED EXTENSION - REENTER ****":BEEP
- 10274 IF L9<1 THEN PRINT "**** FILENAME TOO SHORT ****"
- 10276 IF L9>12 THEN PRINT "**** FILENAME TOO LONG ****"
- 10278 F9=1 'BAD FILENAME - REENTER
- 10280 RETURN
- 11000 PRINT "ERROR NUMBER";ERR;"AT LINE";ERL;"PLEASE NOTE":END
- 12000 I1=INSTR(G$,".")
- 12005 IF I1<>0 THEN G$=LEFT$(G$,I1-1)
- 12010 RETURN
-